home *** CD-ROM | disk | FTP | other *** search
- * Date: 1987 Sep 28 22:51 EDT
- * From: (John F. Chandler) PEPMNT@CFAAMP.BITNET
- *
- * ROVKERM v. 1.2 - KERMIT for the HP2647A terminal
- *
- @@1 EQU TIMER ; On/off switch for timer.
- @@2 EQU IBM ; On/off switch for IBM wait.
- *
- ORG 400Q
- RAMDSK EQU * ; START OF 32K 'RAM DISK'
- ORG 100400Q ; 256 EXTRA OVERLAP
- ASCC 'UKERMIT '255255'',-
- JMP IN ; ENTRY VECTOR ...
- JMP RTRN
- JMP IN
- XRA A
- RET
- NOP
- JMP RTRN
- JMP RTRN
- JMP RTRN
- EJECT
- * A FEW ASCII CHARS
- BEL EQU 7
- BL EQU 32
- BS EQU 8
- CR EQU 13
- DEL EQU 127
- ESC EQU 27
- LF EQU 10
- XON EQU 17
- KRET EQU 357Q ; KEYBOARD CODE FOR RETURN
- *
- EMSGLN EQU 3 ; SCREEN LINE FOR HOST ERROR
- FIDLN EQU 4 ; FILE NAME
- RCNOLN EQU 5 ; RECORD COUNT
- RTRYLN EQU 6 ; RETRY COUNT
- MSGLN EQU 7 ; VARIOUS MESSAGES
- TABCOL EQU 12 ; COMMON TAB COLUMN
- *
- * SYSTEM ENTRY POINTS
- SYSCPY EQU 100Q ; COPY (C) FROM (HL) TO (DE)
- CALROM EQU 106Q ; CALL ROM CODE AT (STACK)
- *
- CURPHD EQU 144Q ; HOME DOWN CURSOR
- CLEARL EQU 155Q ; CLEAR LINE FROM CURSOR
- CLEARS EQU 160Q ; CLEAR DISPLAY FROM CURSOR
- XPUTDC EQU 174Q ; XMIT CHAR TO DCM FROM (A)
- CHINT0 EQU 202Q ; DISPLAY CHARACTER FROM (C)
- MLKOF0 EQU 232Q ; TURN ON MEM LOCK AT (177553)
- BN2DEC EQU 250Q ; CONVERT TO DECIMAL
- $WINDW EQU 352Q ; DISPLAY WINDOW IN (B)
- $KBFNC EQU 402Q ; DISPLAY CHAR OR FUNCTION IN (C)
- $KBPRC EQU 410Q ; UPDATE KEYBOARD STATE
- $CURPLC EQU 413Q ; CLEAN UP DISPLAY/CURSOR
- GTKEY EQU 64005Q ; GET KEY CODE, IF ANY
- BELL EQU 64024Q ; RING BELL
- GETDC EQU 70030Q ; GET CHAR FROM DCM, IF ANY
- * FILE SYSTEM
- $INOPN EQU 422Q ; OPEN FILE FOR INPUT
- $CLOSE EQU 425Q ; CLOSE FILE
- $OUTOPN EQU 430Q ; OPEN FOR OUTPUT
- $READ EQU 433Q ; GET RECORD
- $WRITE EQU 436Q ; PUT RECORD
- $CNTRL EQU 441Q ; PERFORM CONTROL OPERATION
- * SYSTEM VARIABLES
- DCMIP EQU 175673Q ; DCM RING BUFFER INPUT POINTER
- DCMOP EQU 175675Q ; DCM RING BUFFER OUTPUT POINTER
- KBSTT EQU 175762Q ; KEYBOARD STATE
- FBPTR EQU 176136Q ; SYSTEM PTR TO CURRENT FB
- DECBUF EQU 177011Q ; TEMP BUFFER
- LOKROW EQU 177553Q ; SCREEN ROW TO LOCK
- FREPTR EQU 177613Q ; PTR TO FREE MEMORY
- CRSPOS EQU 177700Q ; CURSOR POSITION
- EJECT
- * INITIALIZE PROGRAM
- IN POP H ; SAVE RETURN ADDRESS
- SHLD RETAD+1
- LHLD FREPTR ; STACK AREA
- LXI D,-257
- DAD D
- SHLD OUTFBB ; GET BUFFER
- SHLD TMPFBB
- SHLD RSTSP+1 ; FOR QUITTING
- SPHL
- MVI B,4 ; DSPLY IN WINDOW 4
- CALL SWNDW
- XRA A
- STA STYPE
- MVI A,MSGLN+1
- STA LOKROW
- LXI H,MLKOF0 ; LOCK SCREEN
- PUSH H
- RST 2
- CALL CRS00 ; SCREEN HOME
- LXI H,CLEARS ; CLEAR ALL
- PUSH H
- RST 2
- CALL PSTRLOC
- ASCC 'Rover Kermit 1.2' ; UPDATE AS VERSION CHANGES
- LXI H,0:40
- CALL PCRS
- ASCC 'Send, Receive, Get, Quit, Finish, Logout'
- LXI H,1:40
- CALL PCRS
- ASCC 'Core, Tape, Kermit, Parm'
- CALL DEVFLG
- CALL INDIC ; DISPLAY FLAGS
- LXI H,RCNOLN:TABCOL-8
- CALL PCRS
- ASCC 'Record:'
- LXI H,RTRYLN:TABCOL-9
- CALL PCRS
- ASCC 'Retries:'
- EJECT
- * COMAND LOOP
- WAITING MVI A,1
- STA BLOCK ; RESTORE USUAL BLOCK CHECK
- CALL WAITU ; GET CHAR
- STA CMTBZ
- LXI H,CMTBL
- CALL CMDSP ; FIND AND CALL COMMAND ROUTINE
- JMP WAITING ; RESUME
- *
- * COMMAND TABLE
- CMTBL DB CHAR C
- DW CORE ; TO/FROM MEMORY
- DB CHAR E
- DW EXIT
- DB CHAR F
- DW UNSRV ; FINISH
- DB CHAR G
- DW GET
- DB CHAR K
- DW KERMCMD
- DB CHAR L
- DW UNSRV ; LOGOUT
- DB CHAR P
- DW SET ; PARM
- DB CHAR Q
- DW EXIT
- DB CHAR R
- DW RECEIVE
- DB CHAR S
- DW SEND
- DB CHAR T
- DW TAPE ; TO/FROM TAPE
- DB 128+CHAR h
- DW FUNC ; HOME
- DB 128+CHAR F
- DW FUNC ; HOME DOWN
- DB 128+CHAR S
- DW FUNC ; ROLL UP
- DB 128+CHAR T
- DW FUNC ; ROLL DOWN
- DB 128+33Q
- DW FUNC ; COMMAND MODE
- CMTBZ DB 0
- DW ERR1 ; NONE OF THE ABOVE
- *
- ERR1 CALL MSGBP
- ASCC 'Bad command'
- MSGBP CALL BEEPM
- MSGNO POP H ; PTR TO MESSAGE
- JMP PSTR
- *
- * PERFORM SCREEN FUNCTION
- FUNC MOV C,A
- LXI H,$KBFNC
- PUSH H
- RST 2
- JMP WAITING
- EJECT
- * PERFORM SET FUNCTION
- SET CALL SCRSET
- ASCC 'Prm: oN, oFf, Chr, Val'
- CALL WAITU ; GET COMMAND
- LXI H,EMSGLN:5
- CPI CHAR C ; CHAR?
- JZ SETCHR
- CPI CHAR V ; VALUE?
- JZ SETVAL
- MVI B,160Q ; MOV M,B
- CPI CHAR F ; OFF?
- JZ SETFLG
- INR B ; MOV M,C
- CPI CHAR N ; ON?
- JNZ ERR1 ; NONE OF THE ABOVE
- SETFLG MOV A,B
- STA STFL ; SET ON OR OFF
- CALL PCRS ; PROMPT FOR OPTION
- ASCC 'IBM, Timer, 8-bit'
- CALL WAITU
- LXI D,STBLZ
- LXI H,STBL
- CALL FLLK ; LOOK UP OPTION
- XCHG
- STFL MOV M,C ; OR MOV M,B
- JMP INDIC ; DISPLAY LATEST SETTINGS
- *
- SETVAL CALL PCRS ; PROMPT FOR OPTION
- ASCC 'Bufsz, Hndshk, Mark, Retry, Time'
- CALL GETNUM
- PUSH H
- LXI D,SNTBLZ
- LXI H,SNTBL
- CALL FLLK ; LOOK UP OPTION
- POP H ; RETRIEVE VALUE
- MOV A,L
- CMP C
- JC ERR1 ; TOO SMALL
- CMP B
- JNC ERR1 ; TOO BIG
- STAX D ; SET NEW VALUE
- JMP INDIC ; DISPLAY LATEST SETTINGS
- *
- SETCHR CALL PCRS ; PROMPT FOR OPTION
- ASCC 'Src, Dest, Quote, Rept, 8-bit, Blk-chk'
- CALL WAITU
- LXI D,SCTBLZ
- LXI H,SCTBL
- CALL FLLK ; LOOK UP OPTION
- PUSH B
- CALL WAITU
- POP H
- MOV C,M ; USE OLD VALUE AS 'DEFAULT'
- XCHG
- RST 1 ; CALL CHECKER
- STAX D ; STORE NEW VALUE
- JMP INDIC ; DISPLAY LATEST SETTINGS
- EJECT
- * OPTION LOOK-UP
- FLLK PUSH D ; SAVE END OF TABLE
- STAX D ; MARK LAST ITEM
- FLLP CMP M ; FOUND?
- INX H
- MOV E,M ; GET ADR
- INX H
- MOV D,M
- INX H
- MOV C,M ; GET DATA
- INX H
- MOV B,M
- INX H
- JNZ FLLP ; NOT FOUND YET
- MOV A,L ; SAVE ITEM PTR
- POP H ; RETRIEVE PTR TO END OF LIST
- SUB L
- POP H ; GRAB RETURN ADR
- DCR A
- JP ERR1 ; RAN OFF END
- PCHL ; OK
- *
- * TABLE OF ON/OFF SWITCHES
- STBL DB CHAR I ; IBM
- DW IBM,INSTR CALL:INSTR LXI
- DB CHAR T ; TIMER
- DW TIMER,INSTR JZ:INSTR JC
- DB CHAR 8 ; 8-BIT
- DW SQU8,CHAR Y:CHAR N
- STBLZ DB 0
- * TABLE OF CHARACTER OPTIONS: CHECK ROUTINE, LOCATION
- SCTBL DB CHAR S ; SOURCE
- DW UPPER,LNAME
- DB CHAR D ; DESTINATION
- DW UPPER,RNAME
- DB CHAR Q ; QUOTE
- DW CKQC,QUOTE
- DB CHAR R ; REPEAT
- DW CKQC,DPTQ
- DB CHAR 8 ; 8-BIT
- DW CKQC,SQU8
- DB CHAR B ; BLOCK-CHECK
- DW CKBKC,BKTP
- SCTBLZ DB 0
- * TABLE OF VALUE OPTIONS: LOCATION, MIN:MAX+1
- SNTBL DB CHAR B ; BUFFER SIZE
- DW BUFSZ,20:95
- DB CHAR H ; HANDSHAKE CODE
- DW HNDSHK,0:BL
- DB CHAR M ; MARK
- DW MARK,0:BL
- DB CHAR R ; RETRY
- DW RETRY,1:200
- DB CHAR T ; TIME-OUT
- DW TIME,1:95
- SNTBLZ DB 0
- EJECT
- * RESET DIALOG
- SCRSET LXI H,$KBPRC
- PUSH H
- RST 2 ; UPDATE STATE
- LXI H,0
- SHLD RECCT+1
- CALL PRTRY
- XRA A
- STA CXZ+1 ; CLEAR INTERRUPT FLAG
- MVI A,XON
- STA XFLEN ; ASSUME QUICK TRANSFER
- LDA STYPE
- ORA A
- CNZ DCMFLH ; FLUSH BUFFER
- MVI A,BL ; PACKET NUMBER
- STA SSEQ
- MVI A,CHAR N
- STA SNDFL+1 ; NOTHING SENT YET
- MVI A,INSTR LXI
- STA SPSND ; DISABLE
- LXI H,EMSGLN:0
- CALL CLRLH
- POP H
- CALL PSTR ; SHOW CMD NAME
- PUSH H
- SCRBOT LXI H,CURPHD ; HOME DOWN
- PUSH H
- RST 2
- RET
- * FLUSH DCM BUFFER
- DCMFLH LDA IBM
- CPI INSTR CALL
- RZ ; IBM'S DON'T TYPE AHEAD
- DI
- LHLD DCMIP
- SHLD DCMOP ; RESET BUFFER PTRS
- EI
- RET
- *
- * STORAGE IN MEMORY
- CORE LXI H,RAMOUT
- LXI D,RAMIN
- LXI B,STAR+6
- SETDEV SHLD RCVSET+1
- XCHG
- SHLD SNDSET+1
- MOV H,B ; COPY PTR TO MARKER STRING
- MOV L,C
- SHLD DEVFM+1
- DEVFLG CALL CRS00 ; MOVE CURSOR AWAY ...
- LXI H,2:40
- CALL SETCRS ; AND BACK
- DEVFM LXI H,STAR
- JMP PSTR ; MARK CURRENT SOURCE
- * STORAGE ON TAPE
- TAPE LXI H,TAPOUT
- LXI D,TAPIN
- LXI B,STAR
- JMP SETDEV
- STAR ASCC ' * '
- EJECT
- * RECEIVE A FILE
- RECEIVE CALL SCRSET ; CLEAR RETRY COUNT, ETC
- ASCC 'Rcv'
- RCV1 LXI H,RCVSTI ; SET UP INITIAL WAIT STATE
- CALL VERIFYP ; GET GOOD PACKET
- RCV2 CALL GETPRM ; VALIDATE PARMS
- CMP C ; REPEAT PRFX = QUOTE?
- JNZ *+5 ; NO, THEN USE IT
- MVI A,BL ; FORBID
- STA SPTQ ; FOR ACK
- MOV A,C
- STA SQUO
- LXI H,SNITP ; ACK DATA
- MVI C,SNITL ; LENGTH
- MVI A,CHAR Y
- CALL SPACK ; DO IT
- CALL BUMPNO
- LDA BCTN+1 ; NEGOTIATED BLOCK CHECK
- STA BLOCK ; NOW USE IT
- RHEDR LXI H,RCVSTH ; EXPECT FILE HEADER
- CALL VERIFYP ; GET GOOD PACKET
- LXI H,BUFOUT
- LXI D,FILMS2
- MVI A,LFILM2
- CALL SETDCD
- CALL DECODE
- MVI M,0 ; MARK END
- MOV A,L
- SUI FILMS2>400Q ; GET LENGTH OF NAME
- STA FNMLT+1
- LXI H,FIDLN:TABCOL-6
- CALL CLRLH
- LXI H,FILMSG ; File: ...
- CALL PSTR
- CALL SCRBOT
- RCVSET LXI H,TAPOUT
- LDA RTYPE
- CPI CHAR X
- JNZ *+6
- LXI H,SCRNOUT ; TEXT HEADER: DISPLAY
- CALL SETDCDX
- LXI H,RCVSTD ; NOW EXPECT DATA PACKETS
- SHLD VERPTR+1
- RDATA CALL ACK0 ; SEND ACK
- CALL VERIFY ; WAIT FOR NEXT
- CALL DECODE ; DECODE FROM PACKET
- JMP RDATA ; ACK AND WAIT
- RCVEOF STC
- CALL DCDOPR ; HANDLE END
- CALL ACK0
- JMP RHEDR ; WAIT FOR ANOTHER FILE
- RCVBRK CALL ACK0 ; DONE RECEIVING
- RCVOK LDA CXZ+1 ; HALT?
- DCR A
- JP RCVDIE ; YES
- CALL MSGNO
- XFLEN ASCC ' Transfer done' ; START WITH BEEP OR XON
- RCVDIE CALL MSGBP
- ASCC 'Transfer halted'
- EJECT
- * SEND ARBITRARY COMMAND
- KERMCMD CALL SCRSET
- ASCC 'Cmd'
- CALL PMSG
- ASCC 'Enter command'
- CALL WAITU ; GET TYPE
- CALL RDST ; GET STRING
- RZ
- CALL ENCSTR ; ENCODE AND SEND IT
- LXI H,CMDST ; EXPECT ACK OR LONG REPLY
- CALL VERIFYP
- DCX H
- MOV A,M ; SEE IF 'SHORT REPLY'
- ORA A
- RZ
- CALL SCRBOT
- LXI H,RDAT
- JMP PSTR ; JUST DISPLAY IT
- *
- * GET A FILE FROM KERMIT SERVER
- GET CALL SCRSET
- ASCC 'Get'
- MVI A,CHAR R ; RECEIVE INIT
- CALL RDFNT
- JZ *-5 ; INSIST
- CALL ENCSTR ; ENCODE AND SEND NAME
- JMP RCV1 ; NOW RECEIVE IT
- *
- * ISSUE SERVER COMMAND
- UNSRV CPI CHAR L ; LOGOUT?
- JNZ UNSRV2 ; NO, JUST DO IT
- CALL BEEPM ; YES, GET CONFIRMATION
- CALL PSTRLOC
- ASCC 'Logout? (Y|N) '
- CALL WAITU
- CPI CHAR Y
- JNZ ERR1 ; NOT CONFIRMED: GOOF
- UNSRV2 CALL SCRSET
- ASCC 'Cmd'
- LXI H,STYPE
- MVI M,CHAR G ; 'GENERIC'
- INX H
- LDA CMTBZ ; TYPED COMMAND
- MOV M,A
- MVI B,1 ; 1 BYTE OF DATA
- CALL SPACKC ; SEND IT
- JMP EXIT
- EJECT
- * GET FILE NAME AND SEND
- RDFNT PUSH PSW ; PACKET TYPE
- CALL PMSG
- ASCC 'Enter file name'
- POP PSW
- RDST STA STYPE ; SAVE PACKET TYPE
- LXI H,BUF ; PUT STRING HERE
- MOV E,L ; SAVE START OF DATA
- MVI A,CHAR :
- RDVLP CALL WCHAR
- RDVL2 PUSH H
- CALL WAITU ; GET CHAR
- POP H
- CPI CR ; RET?
- JZ RDVZ ; DONE
- CPI DEL
- JZ RDVBS ; TREAT DEL AS BS
- JNC RDVL2 ; FUNCTION KEY
- CPI BS
- JNZ RDVX ; ORD. CHAR
- RDVBS MOV A,L ; MUST BACK UP
- CMP E ; EMPTY?
- JZ RDVL2 ; YES, READ MORE
- DCX H
- MVI A,BS ; AND BACK UP CURSOR
- JMP RDVLP
- RDVX CPI BL ; CTL?
- JC RDVL2 ; IGNORE
- MOV M,A ; ADD TO BUFFER
- INX H
- JMP RDVLP
- RDVZ MOV A,L
- SUB E ; GET LENGTH
- RZ
- MVI M,0 ; MARK END OF STRING
- PUSH PSW ; SAVE LENGTH
- CALL SCRBOT
- LXI H,BUF ; STRING STARTS HERE
- POP PSW
- ORA A ; RETURN 'NZ'
- RTRN RET
- EJECT
- * SEND A FILE FROM CURRENT POSITION ON TAPE
- SEND CALL SCRSET
- ASCC 'Snd'
- MVI A,INSTR LXI+20Q
- STA EOFFL
- MVI A,CHAR S
- LXI H,SNITP ; INIT PACKET
- MVI C,SNITL
- CALL SPACK ; SEND IT
- LXI H,SNDST ; EXPECT ACK'S
- CALL VERIFYP
- CALL GETPRM ; ANALYZE RESPONSE
- LXI H,SPTQ ; MY SUGGESTION
- CMP M ; AGREES?
- JZ *+7 ; YES, USE IT
- MOV A,C ; NO, SUPPRESS REPEATS
- STA RPTQ
- LDA SQUO
- CMP C ; MUST MATCH
- CNZ ERAK ; BAD ACKNOWLEDGE
- CALL BUMPNO ; COUNT PACKETS
- BCTN MVI A,1 ; USUAL BLOCK CHECK
- STA BLOCK
- MVI A,CHAR F
- CALL RDFNT ; GET FILE NAME, IF ANY
- JNZ SNDNM ; GOT NAME PTRS
- LDA SNDSET+1
- CPI RAMIN>400Q ; FROM RAM?
- LDA FNMLEN
- LXI H,FNM
- JZ SNDNM ; YES, THEN ALREADY GOT NAME
- LXI H,SFN ; NO, USE DUMMY
- MVI A,SFNL
- SNDNM CALL ENCSTR ; ENCODE AND SEND NAME
- LXI H,FIDLN:TABCOL
- CALL SETCRS ; SET CURSOR
- LHLD SVBFP+1
- CALL PSTR ; DISPLAY FILE NAME
- CALL SCRBOT
- CALL VERIFY
- MVI A,CHAR D ; NOW SEND DATA
- STA STYPE
- SNDSET LXI H,TAPIN
- CALL SETDCD
- XRA A
- STA SVBFL+1 ; NO SAVED DATA
- CALL BUMPNO
- * MAIN SEND LOOP
- SLOOP CALL MAKPAK ; SEND A PACKET FROM INPUT
- CALL VERIFY ; WAIT FOR ACK
- CALL BUMPNO
- LDA STYPE ; CHECK FOR EOF
- CPI CHAR D
- JZ SLOOP ; NO, STILL SENDING DATA
- MVI A,CHAR B ; BREAK CONNECT
- CALL SPACK0
- CALL VERIFY ; WAIT FOR ACK
- JMP RCVOK ; DONE, SHOW MSG
- EJECT
- * ENCODE STRING AT (HL) OF LENGTH (A), AND SEND IT
- ENCSTR MVI B,0 ; JUST IN CASE
- ORA A ; ANYTHING IN STRING?
- JZ SPACKC ; NO, JUST SEND (TYPE ALREADY SET UP)
- SHLD SVBFP+1 ; SAVE PTRS
- STA SVBFL+1
- * ENCODE DATA FOR SENDING
- MAKPAK MVI A,INSTR CNZ
- STA MAKEOF
- CXZ MVI A,0 ; INTERRUPT?
- DCR A
- JP DISC ; YES, DISCARD
- SVBFP LXI H,0-0 ; SAVED INPUT PTR
- SVBFL MVI A,0-0 ; AND LENGTH REMAINING
- LXI D,SDAT ; OUTPUT BUFFER
- PUSH D
- RBSIZ EQU *+1 ; MAX ALLOWED SEND
- MVI B,92
- MAKPL ORA A
- JNZ MAKPA1 ; USE IT
- EOFFL JMP MAKPZ ; OR LXI D
- PUSH B
- INR A ; SET 'NZ'
- CALL DCDOPR
- POP B
- JNC MAKPA1
- MVI A,INSTR JMP ; HIT EOF
- STA EOFFL
- XRA A
- JMP FUL1 ; SEND LAST PACKET
- MAKPA1 MOV C,A ; SAVE LENGTH
- RQUO EQU *+1 ; QUOTE CHAR (E)
- RQU8 EQU *+2 ; 8-BIT QUOTE (D)
- LXI D,CHAR #:CHAR &
- MVI A,INSTR JNZ ; DATA FOUND THIS BUFFER
- STA MAKEOF
- MOV A,M ; GET NEXT BYTE
- INX H
- CMP M ; AT LEAST 2?
- DCX H
- JNZ RPTZ ; NO, FORGET IT
- LDA RPTQ ; DOING REPEATS?
- CMP E
- JZ RPTZ ; OFF IF SAME AS QUOTE
- MOV A,B ; CHECK OUTPUT BUFFER
- CPI 5
- JC RPTZ ; NO ROOM
- MOV A,C ; CHECK DATA LENGTH
- ORA A ; 256?
- JZ SLP2 ; YES, LONG
- CPI 4
- JC RPTZ ; NOT WORTH IT
- SLP2 PUSH B ; SAVE CURRENT COUNT
- MVI A,94 ; MAX RPT COUNT
- INR C
- DCR C
- JZ SLIM ; 256
- CMP C
- JNC *+4
- SLIM MOV C,A
- PUSH B
- MOV A,M ; GET CHAR AGAIN
- RPTL INX H
- DCR C
- JZ RPTX ; END, TALLY UP
- CMP M ; STILL MATCHING?
- JZ RPTL
- RPTX XTHL ; GET OLD #
- MOV A,C
- SUB L ; -(REPEAT COUNT)
- POP H
- XTHL ; STARTING COUNT
- CPI -3 ; WORTH IT?
- JC RPTY ; YES, DO IT
- MOV C,L ; NO, RESTORE PTRS
- POP H
- ADD L ; BACK UP BUFFER PTR TO 1ST
- MOV L,A
- JC *+4
- DCR H
- JMP RPTZ ; GIVE UP
- RPTY STA MRPTC+1 ; SAVE -(COUNT)
- ADD L ; CORRECT FINAL COUNTER
- MOV C,A
- INR C
- POP H ; -> 1ST NON-MATCH
- DCX H ; LAST MATCH
- XTHL ; GET OUTPUT PTR
- LDA RPTQ ; GET REPEAT PRFX
- MOV M,A ; ADD TO BUFFER
- INX H
- DCR B
- MVI A,BL
- MRPTC SUI 0-0 ; GET CHAR(COUNT)
- MOV M,A
- INX H
- DCR B
- XTHL ; BACK TO INPUT
- RPTZ MOV A,D ; GET 8-BIT QUOTE
- CMP E ; SAME AS QUOTE?
- MOV A,M ; GET DATA CHAR
- XTHL
- JZ TCHR ; NO 8-BIT QUOTING
- ORA A
- JP TCHR ; 8TH BIT OFF
- DCR B ; SEE IF ROOM
- JZ FULL ; NO, CLOSE PACKET NOW
- DCR B ; MIGHT NEED 3
- JZ FULL
- INR B
- MOV M,D ; INSERT QUOTE
- INX H
- ANI 177Q
- TCHR CMP E ; QUOTE?
- JZ SPECL ; YES, SPECIAL CHAR
- CMP D ; 8-BIT QUOTE?
- JZ SPECL
- RPTQ EQU *+1
- CPI CHAR ~ ; REPEAT PRFX?
- JZ SPECL
- CPI DEL
- JZ SPECX
- CPI BL
- JNC ADDIT ; NORMAL CHAR
- SPECX XRI 100Q ; DECONTROLLIFY
- SPECL DCR B ; SEE IF ROOM
- JZ FULL ; NO, CLOSE OUT
- MOV M,E ; YES, ADD QUOTE
- INX H
- ADDIT MOV M,A ; ADD CHAR TO BUFFER
- INX H
- XTHL ; INPUT PTR
- INX H ; USED IT
- DCR C
- DCR B ; COUNT OUTPUT
- MOV A,C
- JZ FUL1 ; FILLED BUFFER
- ORA A ; ANY MORE DATA?
- JNZ MAKPL ; YES, KEEP GOING
- LDA STYPE
- CPI CHAR D ; SENDING FILE?
- JNZ FUL2 ; NO, ASSUME JUST A STRING
- MOV A,B
- CPI 3 ; MUCH ROOM?
- MOV A,C
- JNC MAKPL ; ENOUGH ANYWAY
- JMP FUL1 ; NO, SEND IT OFF
- FULL MOV A,C ; REMAINING COUNT
- XTHL
- FUL1 CALL SVBFS ; SAVE PTR TO DATA
- FUL2 POP H ; OUTPUT PTR
- MOV A,L
- SUI SDAT>400Q ; LENGTH
- MOV B,A ; SET UP FOR SPACK
- MAKEOF JNZ SPACKC ; OR 'CNZ'
- MAKPY PUSH H
- * REACHED EOF
- MAKPZ MVI A,CHAR Z ; SEND EOF
- POP D ; FLUSH OUTPUT PTR
- JMP SPACK0
- *
- DISC STC ; SIGNAL 'EOF'
- CALL DCDOPR
- JMP MAKPY
- EJECT
- * INPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN,
- * 'NZ,NC' => READ, 'C' => CLOSE
- * ON EXIT: 'NC' => (HL)->BUFFER, (A)=LENGTH (MOD 256)
- * 'C' => REACHED EOF
- *
- * TAPE INPUT
- TAPIN JC RDTEOF
- JNZ RDTAP
- XRA A
- STA TMPFB+3
- LXI H,$INOPN
- LXI D,TMPFB
- CALL FSYS ; OPEN TAPE
- CNZ ERWR ; GIVE UP
- RET ; OK
- RDTAP XRA A
- STA TMPFBC ; BUFFER LENGTH
- LXI D,TMPFB
- LXI H,$READ ; READ OPR
- CALL FSYS
- JNZ RDTEOF ; ASSUME EOF
- LDA TMPFBC ; BYTE COUNT
- LHLD TMPFBB ; BUFFER
- RET
- RDTEOF CPI 3
- CNC ERIO ; TAPE ERROR
- LXI D,TMPFB
- CALL FBRLSE ; FREE TAPE
- STC
- RET
- *
- * INPUT FROM CORE
- RAMIN RC
- JNZ RDRAM
- LHLD RAMD0 ; START OF FILE
- RDRAM SHLD SVBFP+1
- PUSH D
- RAMZ LXI D,RAMDSK ; END OF FILE
- MOV A,E
- SUB L ; AMOUNT LEFT
- MOV L,A
- MOV A,D
- SBB H
- MOV H,A
- POP D
- RC ; PAST END??
- ORA L ; ANY?
- STC
- RZ ; NONE, RETURN EOF
- ORA A ; CLEAR 'C'
- INR H ; AT LEAST 256?
- DCR H
- LHLD SVBFP+1 ; RETRIEVE CURRENT PTR
- RZ ; LITTLE LEFT
- XRA A ; LOTS LEFT
- RET
- EJECT
- * SEND A PACKET
- SPACK0 MVI C,0
- * SEND A PACKET - ENTER HERE WITH (HL)->DATA, (C)=LENGTH, (A)=TYPE
- SPACK LXI D,STYPE
- STAX D ; SAVE TYPE
- INX D
- MOV B,C ; SAVE LENGTH
- INR C
- DCR C ; ANY DATA?
- CNZ SYSCPY ; YES, COPY IT
- * HERE (B)=DATA LENGTH, BUFFER CONTAINS TYPE+DATA
- SPACKC LDA MARK
- LXI H,SPAKT
- MOV M,A ; SET SYNCH MARK
- INX H
- CALL SPINT
- INR B
- INR B ; COUNT SEQ,TYPE IN CHECKSUM
- LDA BLOCK ; INCLUDE CHECK IN PACKET LENGTH
- ADD B
- ADI BL ; GET CHAR(LEN)
- MOV M,A
- MVI C,0 ; CLEAR HIGH BYTE OF CHECK
- SPCHKL INX H
- ADD M ; TALLY SUM
- JNC *+4
- INR C ; BUMP HIGH BYTE
- DCR B
- JNZ SPCHKL
- INX H ; PTR TO CHECK
- XCHG ; SAVE PTR
- CALL CHEK1 ; CONVERT TO 1-BYTE OR 2-BYTE CHECK
- XCHG
- MOV M,A ; SAVE IN BUFFER
- INX H
- LDA BLOCK
- STA SNDFL+1 ; INDICATE SOMETHING SENT
- DCR A
- JZ *+5 ; JUST ONE BYTE
- MOV M,C ; SAVE OTHER BYTE
- INX H
- REOL EQU *+1 ; HIS END-OF-LINE
- MVI M,CR ; OR WHATEVER
- INX H
- MVI M,0 ; END WITH NULL
- SPSND CALL RWAIT ; OR LXI - WAIT FOR XON
- LXI D,SPAKT ; WHOLE PACKET
- SPSLP LDAX D
- INX D
- ORA A
- RZ
- LXI H,XPUTDC ; XMIT CHAR
- PUSH H
- RST 2
- JMP SPSLP ; UP TO NULL
- EJECT
- * COMPUTE CHECK FROM (A) OR (A:C), CLOBBERS H,L,C
- CHEK1 MOV L,A ; LOW BYTE OF NUMBER
- MOV H,C ; HIGH BYTE
- MOV C,A
- LDA BLOCK
- DCR A ; ONE OR TWO?
- JNZ CHEK2
- MOV H,C
- DAD H ; SHIFT 2 BITS
- RAL
- DAD H
- RAL
- ADD C
- CHEKR ANI 77Q
- ADI BL ; GET CHAR(CHECK)
- RET
- CHEK2 DAD H ; COMPUTE 2-BYTE CHECK FROM (HL)
- DAD H
- MOV A,C ; FRESH COPY OF LOW BYTE
- ANI 77Q
- ADI BL ; GET CHAR(LO-CHECK)
- MOV C,A ; IN (C)
- MOV A,H
- JMP CHEKR ; AND CHAR(LO-CHECK)
- *
- * CHECK INTERRUPTS
- SPINT LDA CXZ+1
- DCR A
- RM ; OK
- MOV C,A
- LDA STYPE
- CPI CHAR Y
- JZ SPINT1 ; MAKING AN ACK
- MVI C,CHAR D-CHAR X
- CPI CHAR Z
- JZ SPINT1 ; MAKING AN EOF
- CPI CHAR D
- RNZ
- MVI B,0 ; MAKING DATA
- MVI A,CHAR Z ; CHANGE TO EOF
- STA STYPE
- SPINT1 MOV A,C ; FLAG FOR X,Z,D
- DCR B
- INR B
- RNZ ; ALREADY HAD THIS STUFF
- INR B ; MUST ADD A BYTE FOR REJECTION
- ADI CHAR X
- STA SDAT
- RET
- EJECT
- * WAIT FOR XON FROM HOST
- RWAIT LXI H,RTRN ; TIMEOUT EXIT
- CALL TIMSET
- RWT1 CALL GCH ; GET CHAR
- CPI ESC
- JZ RWT2 ; SUPPRESS ESCAPES
- PUSH PSW
- CALL WCHAR ; ECHO EVERYTHING
- POP PSW
- HNDSHK EQU *+1
- RWT2 CPI XON
- JNZ RWT1 ; KEEP WAITING
- RET
- *
- * SET TIMEOUT EXIT
- TIMSET SHLD GCHTX+1
- IBM EQU *+1
- MVI A,INSTR CALL ; OR LXI
- STA SPSND
- RET
- EJECT
- * RECEIVE A PACKET
- RPACK PUSH D
- LXI H,RPBAK ; TIMEOUT EXIT
- CALL TIMSET
- RP1 CALL GCH ; GET A CHAR
- JZ RBEG ; FOUND MARK CHAR
- CALL WCHAR
- JMP RP1
- RBEG CALL GCH ; GET LENGTH CHAR
- JZ RBEG ; ANOTHER MARK
- MVI D,0 ; CLEAR HIGH BYTE OF SUM
- MOV C,A ; INIT LOW BYTE
- BLOCK EQU *+1
- SUI 1
- JM RPRET ; IMPOSSIBLE!?
- SUI 42Q ; MIN VALUE
- JC RPRET ; IMPOSSIBLE
- STA RLEN ; DATA LENGTH
- MOV B,A
- INR B ; ALSO COUNT SEQ,TYPE
- INR B
- LXI H,BUF
- RLP CALL GCH
- JZ RBEG ; START OVER
- CPI BL ; CTL?
- JC RPRET ; NOT ALLOWED
- MOV M,A ; ADD TO BUFFER
- ADD C ; KEEP SUM
- MOV C,A
- JNC *+4
- INR D ; PROPAGATE CARRY
- INX H
- DCR B
- JNZ RLP
- MVI M,0 ; END OF PACKET
- MOV C,D
- CALL CHEK1 ; DONE, GET CHECK
- MOV D,A ; SAVE LOW BYTE
- CALL GCH ; GET CHECK FOR PACKET
- JZ RBEG ; I DON'T BELIEVE IT
- CMP D ; MATCH?
- JNZ RPRET ; TOO BAD
- LDA BLOCK
- DCR A
- JZ RPRET ; 1-BYTE, OK (CC='Z')
- CALL GCH ; GET CHECK FOR PACKET
- JZ RBEG ; I DON'T BELIEVE IT
- CMP C ; MATCH?
- RPRET MVI A,CHAR N ; INDICATE BAD PACKET
- RPBAK LXI H,RTYPE ; PTR ON RETURN
- POP D ; RESTORE
- RZ ; OK
- MOV M,A ; ERROR
- RET
- EJECT
- * DECODE INFO
- DECODE LXI H,RDAT ; DATA PTR
- LDA RLEN ; DATA LENGTH
- ORA A ; ANY?
- MOV C,A
- LDA SVBFL+1 ; ROOM FOR OUTPUT
- MOV B,A
- XCHG
- LHLD SVBFP+1 ; OUTPUT PTR
- RZ ; NO DATA
- PUSH H
- LHLD RQUO ; GET QUOTE, 8-BIT
- XCHG
- * (HL)->INPUT, (C)=INPUT LENGTH, (B)=OUTPUT ROOM
- * (D)=8-BIT, (E)=QUOTE, OUTPUT PTR ON STACK
- DCDL LDA RPTQ ; RPT PRFX
- CALL TQCH ; SEE IF ANY
- MVI A,0 ; NO REPEATS
- JZ DCDR
- MOV A,M ; GET RPT COUNT
- SUI BL+1 ; CONVERT
- CC ERRP ; BAD COUNT
- CALL IINP ; GOBBLE
- DCDR STA RPTCT ; SAVE COUNT
- MOV A,D ; SEE IF 8-BIT
- CALL TQCH
- MVI A,200Q ; PARITY BIT IF SO
- JNZ *+4
- XRA A ; NOT
- STA STPR+1 ; SAVE
- MOV A,E
- CALL TQCH1 ; SEE IF QUOTE
- MOV A,M
- JZ STPR ; NO, USE CHAR
- CMP E ; QUOTE-QUOTE?
- JZ STPR ; SPECIAL CHARS, OK
- CMP D
- JZ STPR
- LDA RPTQ
- CMP M
- JZ STPR
- MOV A,M
- XRI 100Q ; CONTROLLIFY
- STPR ORI 0-0 ; SET PARITY BIT
- XTHL ; GET OUTPUT PTR
- DCDO MOV M,A ; ADD TO OUTPUT
- INX H
- DCR B ; FULL?
- JZ DCDW ; YES, WRITE IT
- CPI LF ; CHECK FOR RECORDS
- JNZ DCDY ; NO
- PREV EQU *+1 ; PREVIOUS CHAR
- MVI A,0-0
- CPI CR ; PRECEDED BY CR?
- MVI A,LF
- JNZ DCDY ; NO, OK
- * WRITE OUT
- DCDW PUSH PSW ; SAVE CURRENT CHAR
- ORI 1 ; SET CC='NZ,NC'
- CALL DCDOPR ; WRITE FULL BUFFER
- POP PSW
- DCDY STA PREV
- RPTCT EQU *+1 ; REPEAT COUNT
- MVI A,0-0
- DCR A ; ANY MORE?
- JM DCDZ ; NO
- STA RPTCT ; KEEP COUNTING
- LDA PREV
- JMP DCDO ; DO IT AGAIN
- DCDZ XTHL
- INX H
- DCR C ; INPUT DONE?
- JNZ DCDL ; NO, KEEP COPYING
- POP H ; RECOVER OUTPUT PTR
- MOV A,B
- JMP SVBFS ; SAVE FOR NEXT TIME
- *
- * CHECK DATA FOR PREFIX IN (A). IF NOT, RETURN 'Z'
- * IF SO, GOBBLE CHAR AND RETURN 'NZ'
- TQCH CMP E ; SAME AS QUOTE?
- RZ ; NOT IN USE
- TQCH1 CMP M ; FOUND ONE?
- JNZ RETZ ; NO, RETURN
- IINP INX H ; ADVANCE INPUT PTR
- DCR C ; CHAR USED UP
- CZ ERQU ; BROKEN STRING
- RET
- RETZ XRA A ; SET 'Z'
- RET
- EJECT
- * FIRST RESET CXZ FLAG
- SETDCDX XRA A
- STA CXZ+1
- * (HL)->ROUTINE, (DE)->BUFFER, (A)=LENGTH
- SETDCD SHLD DCDOPR+1 ; SET OUTPUT ROUTINE
- XCHG
- CMP A ; SET CC='Z'
- DCDOPR JMP 0-0
- *
- * OUTPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN,
- * 'NZ,NC' => WRITE, 'Z,C' => DUMP+CLOSE (HL)->END+1
- * ON EXIT, (HL)->BUFFER, (B)=LENGTH (MOD 256)
- *
- * OUTPUT TO TAPE
- TAPOUT JC TAPEOF
- JNZ WRTAP ; WRITE RECORD
- CALL FBSET ; OPEN OUTPUT
- CNZ ERWR ; NOT AVAILABLE
- TAPST1 LHLD OUTFBB ; TAPE BUFFER
- XRA A
- SVBFS SHLD SVBFP+1 ; OUTPUT PTR
- STA SVBFL+1
- RET
- TAPEOF CALL BUFCHK ; DUMP BUFFER
- MVI A,1 ; SET FOR CTL
- STA OUTFB+3
- MVI A,5 ; TAPE MARK
- STA OUTFBC+1
- LXI H,$CNTRL ; CONTROL OPERATION
- CALL FSYSO
- LXI D,OUTFB
- JMP FBRLSE ; FREE TAPE
- * (HL)->END OF FILLED BUFFER, (B)=REMAINING ROOM
- WRTAP PUSH B ; WRITE TAPE RECORD
- PUSH D
- MOV A,L
- LHLD OUTFBB ; BUFFER PTR
- SUB L ; GET LENGTH
- STA OUTFBC
- LXI H,$WRITE ; WRITE ROUTINE
- CALL FSYSO ; DO IT
- CNZ ERIO ; TOO BAD
- POP D
- POP B
- WRTZ LHLD OUTFBB ; NEW OUTPUT PTR
- MVI B,0
- RET
- EJECT
- * OUTPUT TO SHORT BUFFER
- BUFOUT JZ SVBFS ; SETUP - ADR,LEN IN HL,A
- POP D ; JUST RETURN WHEN FILLED
- POP D
- RET
- *
- * OUTPUT TO LONG CORE BUFFER
- RAMOUT JC RAMEOF
- JNZ WRTRAM ; WRITE RECORD
- LXI H,FILMS2 ; COPY FILE NAME+LENGTH
- LXI D,FNM
- MVI C,FNML
- FNMLT MVI A,1 ; SET BY INPUT
- CMP C
- JC *+4
- MOV A,C ; MAX LENGTH
- STA FNMLEN
- CALL SYSCPY
- LHLD RAMD0 ; BIG BUFFER
- XRA A
- JMP SVBFS ; SET UP PTRS
- RAMEOF LHLD SVBFP+1 ; END OF DATA
- SHLD RAMZ+1 ; SAVE
- RET
- WRTRAM MVI B,0 ; ALLOW FULL 256 BUFFER
- INR H ; TEST FOR OVF
- DCR H
- RP ; OK
- CALL RAMEOF ; SAVE END PTR
- CALL ERIO
- *
- * OUTPUT TO SCREEN
- SCRNOUT JC BUFCHK
- JZ TAPST1 ; SET PTRS
- MVI M,0 ; MARK END
- LHLD OUTFBB
- CALL PSTR ; DISPLAY IT
- JMP WRTZ
- * DUMP BUFFER IF NOT EMPTY
- BUFCHK LDA SVBFL+1 ; ANYTHING IN BUFFER?
- LHLD SVBFP+1
- ORA A
- JNZ DCDOPR ; YES, DUMP IT
- RET
- EJECT
- * ANALYZE INIT PARMS
- GETPRM LDA RLEN ; DATA LENGTH
- MOV B,A
- LXI H,RDAT
- CALL GETOP ; BUFFER LENGTH
- SUI BL
- JZ MAXBF ; DEFLT
- CPI 26 ; MIN
- JNC *+6 ; OK
- LDA *-4 ; USE MIN
- CPI 96 ; MAX
- JC *+6 ; OK
- MAXBF LDA *-4 ; USE MAX
- SUI 6 ; ENVELOPE: MARK,LEN,SEQ,TYPE + CHECK
- STA RBSIZ
- CALL GETOP ; TIME
- TIMER EQU *+1
- MVI C,INSTR JZ
- SUI BL
- JNC *+6
- XRA A ; DON'T
- MVI C,INSTR JC ; DISABLE TIMER
- ADD A ; X 4
- JC MAXT ; TOO BIG
- ADD A
- JNC SAVT
- MAXT XRA A
- SAVT STA RTIM
- MOV A,C
- STA TIMER1
- CALL GETOP ; SKIP NPAD
- CALL GETOP ; PAD CHAR
- CALL GETOP ; EOL
- SUI BL
- JZ DFLTEOL
- CPI BL ; MUST BE CONTROL
- JC *+5 ; OK
- DFLTEOL MVI A,CR
- STA REOL
- CALL GETOP ; QUOTE CHAR
- MVI C,CHAR # ; DEFAULT
- CALL CKQC ; VALIDATE
- STA RQUO
- MOV C,A ; SAVE (AND RETURN)
- LDA SQU8 ; 8-BIT
- MOV E,A ; ALSO SAVE
- CALL GETOP ; 8-BIT QUOTE
- CALL CKQ8 ; VALIDATE HIM
- MOV D,A ; SWAP
- MOV A,E
- MOV E,D
- CALL CKQ8 ; VALIDATE ME
- CMP E ; AGREE?
- JZ *+4 ; YES, OK
- MOV A,C ; NO, TURN OFF
- STA RQU8
- CALL GETOP ; BLOCK CHECK
- CALL CKBKC ; VALIDATE IT
- MOV D,A
- LDA BKTP
- CMP D ; DO WE AGREE?
- CNZ CKBK1 ; NO, USE '1'
- SUI CHAR 0 ; CONVERT TO BINARY
- STA BCTN+1 ; AND SAVE
- CALL GETOP ; REPEAT PRFX
- CPI 41Q
- JC NRPT ; INVALID
- CPI DEL
- JNC NRPT ; NOPE
- CMP E ; DUPLICATE?
- JNZ *+4 ; OK
- NRPT MOV A,C ; TURN OFF
- STA RPTQ
- RET
- *
- * FETCH PARAMETER BYTE (OR BLANK IF NONE)
- GETOP MVI A,BL ; DEFAULT
- DCR B ; ANY MORE DATA?
- RM ; NO, USE DEFAULT
- MOV A,M ; YES, GET IT
- INX H
- RET
- *
- * VALIDATE QUOTE CHAR IN (A), DFLT=(C)
- CKQ8 CPI CHAR Y ; SPECIAL MEANING FOR 8-BIT
- JNZ CKQC
- MOV A,E ; USE OTHER'S
- CKQC CPI 41Q ; MUST BE PRINTABLE
- JC DFQC ; NO
- CPI 77Q ; NOT UPCASE
- RC ; OK
- CPI 140Q
- JC DFQC
- CPI DEL
- RC ; OK
- DFQC MOV A,C ; DEFAULT
- RET
- *
- * VALIDATE BLOCK-CHECK IN (A)
- CKBKC CPI CHAR 2 ; ONLY ALTERNATIVE TO '1'
- RZ ; OK
- CKBK1 MVI A,CHAR 1 ; DEFAULT IS 1
- RET
- EJECT
- * GET CHAR FROM DATACOMM
- GCH PUSH B ; SAVE REGS
- PUSH D
- PUSH H
- RTIM EQU *+2 ; TIME OUT PERIOD
- LXI H,0
- PUSH H ; TIMEOUT COUNTER
- GCHL POP H
- DCX H ; COUNT LOOPS
- MOV A,H
- ORA L ; RUN DOWN?
- TIMER1 JZ TIMEOUT ; OR 'JC' TO DISABLE
- PUSH H
- CALL CKXZ ; SEE IF INTERRUPT
- LXI H,GETDC
- PUSH H
- RST 2 ; GET CHAR
- JZ GCH9 ; GOT ONE
- LDA KBSTT
- CMA ; CHECK FOR CNTL+SHIFTS
- ANI 31Q ; ALL?
- JNZ GCHL ; NO, CHECK AGAIN
- CALL SCRBOT ; INTERRUPT
- GTKL CALL WAITU ; READ KBD
- ORA A ; CHECK FOR FUNCTIONS
- JM GTKW ; DON'T SEND THEM
- LXI H,XPUTDC
- PUSH H
- RST 2 ; SEND
- GTKW CPI CR
- JZ GCHL ; NOW TRY AGAIN
- CALL WCHAR
- JMP GTKL
- GCH9 POP H ; FLUSH COUNTER
- POP H
- POP D
- POP B
- MARK EQU *+1
- CPI 1 ; SYNCH
- RET
- TIMEOUT LXI H,8 ; HOST IS STALLED
- DAD SP ; FLUSH SAVED STUFF
- SPHL
- MVI A,CHAR T ; INDICATE TIMEOUT
- ORA A ; SET 'NZ'
- GCHTX JMP 0-0
- *
- * CHECK FOR INTERRUPT
- CKXZ LXI H,GTKEY
- PUSH H
- RST 2
- RNZ ; OK, NOTHING TYPED
- SUI CHAR X-100Q ; CTL-X?
- JZ *+6 ; YES, THAT'S IT
- CPI CHAR Z-CHAR X ; CTL-Z?
- RNZ
- INR A
- STA CXZ+1 ; SAVE FLAG
- RET
- EJECT
- * SEND ZERO-LENGTH ACK
- ACK0 MVI A,CHAR Y ; ACK
- CALL SPACK0 ; SEND IT AND THEN ...
- * ADVANCE RECORD NUMBER
- BUMPNO LDA SSEQ
- SUI 37Q
- ANI 77Q
- ADI BL
- STA SSEQ ; UPDATE
- CPI BL+10
- JNZ *+8
- MVI A,BEL ; SET TO BEEP AFTER TRANSFER
- STA XFLEN
- LXI D,RCNOLN:TABCOL
- RECCT LXI H,0 ; COUNTER
- INX H
- SHLD RECCT+1
- * PRINT (HL) AT (D/E) ON SCREEN
- SCRNO PUSH H ; SAVE NUM
- LHLD CRSPOS ; SAVE POSITION
- XCHG
- CALL CLRLH
- POP H
- CALL PNUM
- XCHG
- JMP SETCRS ; RESTORE POSITION
- *
- * READ DECIMAL NUMBER FROM KEYBOARD INTO (HL), BREAK IN (A)
- GETNUM LXI H,0 ; INIT
- GETNL CALL WAITU
- CPI CHAR 0 ; VALID DIGIT?
- RC ; NO, THAT'S IT
- CPI CHAR 9+1
- RNC
- SUI CHAR 0 ; CONVERT TO BINARY
- PUSH D ; SAVE REGS
- MOV D,H
- MOV E,L ; COPY LAST VALUE
- DAD H
- DAD H
- DAD D ; x 5
- DAD H ; x 10
- MOV E,A ; NEW DIGIT
- MVI D,0
- DAD D
- POP D
- JMP GETNL ; KEEP READING
- EJECT
- * ESTABLISH NEW STATE, THEN WAIT FOR GOOD PACKET
- VERIFYP SHLD VERPTR+1
- VERIFY POP H
- SHLD VERRET+1 ; SET RETURN ADR
- RETRY EQU *+1
- MVI A,10 ; MAX TRIES
- STA TRIES
- VER1 CALL RPACK
- MOV A,M ; GET TYPE
- CPI CHAR N ; MAYBE NAK
- JZ AGAIN
- CPI CHAR T ; MAYBE TIMEOUT
- JZ AGAIN
- CPI CHAR E ; MAYBE ERROR
- CZ OOPSE
- DCX H ; PTR TO REC NO
- LDA SSEQ ; LAST SENT
- CMP M ; MATCH?
- JNZ VERBAD ; NO, TRY AGAIN
- INX H ; OK
- MOV A,M ; RETRIEVE TYPE
- VERPTR LXI H,*-*
- MOV E,M ; GET PTR TO END OF LIST
- INX H
- MOV D,M
- INX H
- STAX D ; INSERT GUARD
- JMP CMDSP
- *
- VERBAD MVI A,CHAR K ; BAD REC NO
- AGAIN CALL BUMPT
- LXI H,VER1
- PUSH H ; SET 'RETURN' ADR
- SNDFL MVI A,CHAR N
- CPI CHAR N ; ANYTHING SENT YET
- JZ SPACK0 ; NO, SEND NAK
- JMP SPSND ; RESEND
- *
- VERACK LDA RLEN ; GOT ACK
- DCR A ; ANY DATA?
- JNZ VERRET
- LDA RDAT ; GET ONE-AND-ONLY
- SUI CHAR X-1 ; X OR Z?
- JC VERRET
- STA CXZ+1 ; YES, THAT'S IT FOLKS
- VERRET JMP *-*
- *
- * COUNT RETRIES
- BUMPT STA ECODEB ; TYPE OF ERROR
- LXI H,TRIES
- DCR M
- CZ ERTR ; RAN OUT
- RTRCT LXI H,0
- INX H
- PRTRY SHLD RTRCT+1 ; ENTER HERE WITH NEW RETRY TOTAL
- LXI D,RTRYLN:TABCOL
- JMP SCRNO
- EJECT
- * INITIAL STATE FOR RECEIVE
- RCVSTI DW RCVSTIZ ; END OF LIST
- DB CHAR S ; SEND-INIT
- DW VERRET
- RCVSTIZ DS 1
- DW ERTP
- * RECEIVE WAITING FOR FILE HEADER
- RCVSTH DW RCVSTHZ ; END OF LIST
- DB CHAR F ; DISK FILE
- DW VERRET
- DB CHAR X ; DISPLAY FILE
- DW VERRET
- DB CHAR B ; BREAK CONNECTION
- DW RCVBRK
- RCVSTHZ DS 1
- * RECEIVE WAITING FOR DATA
- RCVSTD DW RCVSTDZ ; END OF LIST
- DB CHAR D ; DATA PACKET
- DW VERRET
- DB CHAR Z ; END OF FILE
- DW RCVEOF
- RCVSTDZ DS 1
- DW ERTP
- * SENDING FILE
- SNDST DW SNDSTZ ; END OF LIST
- DB CHAR Y ; ACK IS ONLY ALLOWED
- DW VERACK
- SNDSTZ DS 1
- DW ERTP
- * SENDING SERVER COMMAND
- CMDST DW CMDSTZ ; END OF LIST
- DB CHAR Y ; ACK
- DW VERACK
- DB CHAR S ; LONG REPLY (IF ALLOWED)
- DW RCV2
- CMDSTZ DS 1
- DW ERTP
- EJECT
- * ERROR HANDLER
- OOPSE LXI H,EMSGLN:TABCOL-7
- CALL PCRS
- ASCC 'Error: '
- LXI H,RDAT
- CALL PSTR ; DISPLAY MESSAGE
- CALL PEMSG
- ASCC 'Remote host aborted'
- *
- OOPS POP D ; MSG PTR
- POP H ; ERROR ADR
- SHLD ERADR
- XCHG
- MOV C,M ; GET LENGTH
- INX H
- PUSH H
- MVI A,CHAR E ; ERROR PACKET
- CALL SPACK
- PEMSG CALL BEEPM ; MESSAGE SET UP
- POP H
- CALL PSTR ; DISPLAY
- RSTSP LXI SP,0-0 ; ABORT
- JMP WAITING
- *
- * INDIVIDUAL ERRORS
- ERAK CALL OOPS
- DB ERAKL
- ASCC 'Bad INIT data'
- ERAKL EQU *-ERAK-5
- ERIO CALL OOPS
- DB ERIOL
- ASCC 'I/O error'
- ERIOL EQU *-ERIO-5
- EROTH CALL OOPS
- DB EROTHL
- ASCC 'Unknown error'
- EROTHL EQU *-EROTH-5
- ERQU CALL OOPS
- DB ERQUL
- ASCC 'Split prefix'
- ERQUL EQU *-ERQU-5
- ERRP CALL OOPS
- DB ERRPL
- ASCC 'Bad repeat count'
- ERRPL EQU *-ERRP-5
- ERTP CALL OOPS
- DB ERTPL
- ASCC 'Bad packet type'
- ERTPL EQU *-ERTP-5
- ERTR CALL OOPS
- DB ERTRL
- ASCC 'Retry limit - ',- ; N=> NAK OR BAD PACKET, T=> TIMEOUT
- ECODEB DB 0,0 ; K=> BAD PACKET NUMBER
- ERTRL EQU *-ERTR-5 ; OTHER=> BAD PACKET TYPE
- ERWR CALL OOPS
- DB ERWRL
- ASCC 'No local storage'
- ERWRL EQU *-ERWR-5
- EJECT
- * EXIT TO TERMINAL MONITOR
- EXIT MVI B,1
- CALL SWNDW
- CALL SCRBOT
- CALL PSTRLOC
- ASCC 'TERMINAL READY'013010''
- RETAD JMP 0-0
- *
- * OPEN A FILE FOR OUTPUT
- FBSET LXI H,OUTFB+3 ; PTR TO FILE BLOCK
- MVI M,3
- LXI H,$OUTOPN
- FSYSO LXI D,OUTFB ; FB PTR
- JMP FSYS
- * CLOSE A FILE
- FBRLSE LXI H,$CLOSE ; SYS CLOSE
- LDAX D ; CHECK CODE
- ORA A
- RZ ; NOT ASSIGNED, SKIP IT
- * DO IT
- FSYS PUSH H
- XCHG ; GET REQUESTED FB
- SHLD FBPTR ; SET UP FB
- MVI A,2
- CALL CALROM
- LHLD FBPTR
- INX H
- MOV A,M ; GET RET CODE
- ORA A
- RET
- *
- * SOUND BELL, THEN POSITION CURSOR TO MESSAGE FIELD
- BEEPM LXI H,BELL
- PUSH H
- RST 2
- MSGS LXI H,MSGLN:0
- CLRLH CALL SETCRS ; POSITION TO (HL)
- PUSH H
- LXI H,CLEARL ; CLEAR LINE
- JMP EXRST2
- *
- * HOME CURSOR
- CRS00 LXI H,0
- * MOVE CURSOR TO HL=ROW:COL
- SETCRS SHLD CRSPOS ; SET POS'N
- PUSH H
- LXI H,$CURPLC
- EXRST2 PUSH D
- PUSH B
- MOV C,A
- PUSH H
- RST 2
- POP B
- POP D
- POP H
- RET
- EJECT
- *
- * DISPLAY WINDOW IN (B)
- SWNDW MVI A,1
- LXI H,$WINDW
- PUSH H
- RST 2
- RET
- *
- * READ, UPCASE A CHARACTER
- WAITU CALL WAIT1
- JNZ WAITU
- CPI KRET ; RETURN KEY
- JNZ *+5
- MVI A,CR
- UPPER CPI 96+27
- RNC
- CPI 96+1
- RC
- SUI 32
- RET
- * GET CHAR, IF ANY
- WAIT1 PUSH H
- LXI H,GTKEY
- JMP EXRST2
- EJECT
- * CONTROL BLOCKS, POINTERS
- *
- INDIC LXI H,1:TABCOL
- CALL PCRS
- ASCC 'Btpp."8BR'
- LDA LNAME
- STA LNMS
- LDA RNAME
- STA RNMS
- QUOTE EQU *+1
- MVI A,CHAR #
- STA SQUO ; DEFAULT OPTION
- DPTQ EQU *+1
- MVI A,CHAR ~
- STA SPTQ
- BUFSZ EQU *+1
- MVI A,94
- ADI BL
- STA SNITP
- TIME EQU *+1
- MVI A,3
- ADI BL
- STA STIM
- LXI H,2:TABCOL-7
- CALL PCRS ; DISPLAY SET PARMS
- ASCC 'Parms: ',-
- * SEND INIT DATA
- SNITP DB 94+BL ; BUFSIZ
- STIM DB 3+BL ; TIMEOUT
- DB 0+BL ; NPAD
- DB 100Q ; PAD
- DB CR+BL ; EOL
- SQUO DB CHAR # ; QUOTE
- SQU8 DB CHAR Y ; 8-BIT QUOTE
- BKTP DB CHAR 1 ; CHECK TYPE
- SPTQ DB CHAR ~ ; REPEAT PRFX
- SNITL EQU *-SNITP
- ASCC ' Src: ',-
- LNMS ASCC '* Dst: ',-
- RNMS DB CHAR *
- DB 0 ; MARKS END OF STRING
- CALL MSGS ; SET UP MESSAGE FOR VALUES
- XRA A
- STA SNTBLZ ; MARK END OF TABLE
- LXI H,SNTBL
- INDLP MOV A,M
- ORA A ; REACHED END?
- RZ ; YES
- CALL WCHAR ; NO, PRINT NEXT OPTION
- INX H
- MOV E,M ; FETCH LOCATION
- INX H
- MOV D,M
- INX H
- XCHG
- MOV L,M ; FETCH VALUE
- CALL PNUM1
- MVI A,BL
- CALL WCHAR
- XCHG
- INX H ; SKIP OVER LIMITS
- INX H ; SKIP OVER LIMITS
- JMP INDLP
- *
- * DUMMY FILE NAME
- SFN ASCC 'A.B'
- SFNL EQU *-SFN-1
- FILMSG ASCC 'File: ',-
- FILMS2 DS 20
- LFILM2 EQU *-FILMS2-1
- FNM ASCC 'NULL.FILE' ; INITIAL RAM NAME
- DS 15
- FNML EQU *-FNM
- FNMLEN DB 9
- *
- RAMD0 DW RAMDSK ; START OF BUFFER
- TRIES DS 1 ; RETRY COUNTER
- ERADR DS 2 ; ERROR DETECTION ADR
- *
- * SEND PACKET
- SPAKT DS 2 ; MARK, LENGTH
- SSEQ DS 1 ; PACKET NUMBER
- STYPE DS 1 ; RECORD TYPE
- SDAT DS 96
- * RECEIVE INFO
- RLEN DS 1 ; COUNT
- BUF DS 128
- RTYPE EQU BUF+1
- RDAT EQU BUF+2
- *
- * OUTPUT FILE BLOCK
- OUTFB DB 0,0,0,3
- DW RNAME
- OUTFBB DW 0
- OUTFBC DB 0,0
- OUTFBA DW OUTARG
- DS 6
- OUTARG DS 3
- RNAME ASCC 'R'13''
- DS 6
- * INPUT FILE BLOCK
- TMPFB DB 0,0,0,3
- DW LNAME
- TMPFBB DW 0
- TMPFBC DB 0,0
- DW OUTARG
- DS 6
- LNAME ASCC 'L'13''
- DS 6
- EJECT
- * DISPLAY MESSAGE FROM IN-LINE
- PMSG CALL MSGS
- JMP PSTRLOC
- PCRS CALL SETCRS ; MOVE TO (HL)
- PSTRLOC XTHL ; GET PTR
- CALL PSTR
- XTHL
- RET
- * DISPLAY MESSAGE AT (HL)
- PSTR MOV A,M
- INX H
- ORA A
- RZ ; STOP AT NULL
- CALL WCHAR
- JMP PSTR
- *
- * WRITE CHARACTER FROM (A)
- WCHAR PUSH H
- LXI H,CHINT0
- JMP EXRST2
- *
- * DISPATCH FROM COMMAND LIST
- CMDSP CMP M ; COMPARE AGAINST TABLE
- INX H
- MOV E,M ; FETCH COMMAND ADR
- INX H
- MOV D,M
- INX H
- JNZ CMDSP ; KEEP LOOKING
- XCHG
- PCHL ; GO DO IT
- *
- * DISPLAY FROM (L)
- PNUM1 MVI H,0
- * DISPLAY DECIMAL NUMBER FROM (HL)
- PNUM PUSH B ; SAVE REGS.
- PUSH D
- XCHG
- LXI H,DECBUF
- PUSH H
- LXI H,BN2DEC
- XTHL
- RST 2 ; CONVERT TO STRING
- LXI H,DECBUF
- CALL PSTR
- POP D
- POP B
- RET
- END
-